#    This file is part of robo-ircbot.
#
#    robo-ircbot is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    robo-ircbot is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with robo-ircbot.  If not, see <http://www.gnu.org/licenses/>.

package App::Modular::Module::UrlParser;
use strict;
use warnings;
use LWP::UserAgent;
use base qw(App::Modular::Module);

print ":: UrlParser module loaded.\n";

# Events we want to receive.
sub events { return "PRIVMSG"; }

sub help {
        return (
                "Finds lines containing only a URL and retrieve's the title."
        );
}

# PRIVMSG events.
sub event_privmsg
{
        shift;
        my $e = shift;

        my $help = $e->robo->mod("Helper") || return;

        # Admin commands for URL module.
        if ($help->trigger_switch("urlparser", $e)) {
                return;
        }

        # URL trigger.
        if ($e->data =~ /^(http:\/\/\S+)$/) {
                read_link($e, $1);
        }
}

# Read the link's HTML.
sub read_link
{
        my ($e, $url) = @_;

        # Download the HTML content.
        # The get() function downloads any text file from the web
        # and will store it in a variable.
        my $ua = LWP::UserAgent->new(
                agent => "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.2) ".
                         "Gecko/2008092313 Ubuntu/8.04 (hardy) Firefox/3.1"
        );

        my $response = $ua->head($url);
        if (!$response->is_success) {
                $e->s("PRIVMSG ".$e->dest." :\002url\002: Could not download page head!");
                return;
        }

        # Get the content-type and content-length.
        my $type = $response->header("Content-Type");
        my $length = $response->header("Content-Length");

        # Set the max size of the content we will read in.
        $ua->max_size(10240);

        # If this is text/html, we will try to read the title tag.
        if ($type =~ /text\/html/ || $type =~ /application\/xml/) {
                $response = $ua->get($url);
                if (!$response->is_success) {
                        $e->s("PRIVMSG ".$e->dest." :\002url\002: Could not download page content!");
                        return;
                }

                my $content = $response->content;
                my $title = "N/A";

                # Remove all line feeds/breaks.
                $content =~ s/[\r\n]//g;

                # Search for <title></title> block.
                $title = $1 if ($content =~ /<title>\s*([^<]+)\s*<\/title>/i);

                # Replace any ascii codes with their corresponding characters.
                while ($title =~ m/\&\#(\d+);/g) {
                        my $char = chr($1);
                        $title =~ s/$&/$char/g;
                }

                $e->s("PRIVMSG ".$e->dest." :\002url\002: ".$title.
                      " \002(\002".calc_size($length)."\002)\002");
        } else {
                $e->s("PRIVMSG ".$e->dest." :\002url\002: ".$type.
                      " \002(\002".calc_size($length)."\002)\002");
        }
}

# Return a formatted file size.
sub calc_size
{
        my $length = shift;

        return "N/A" unless ($length);

        # M
        if ($length > (1024 * 1024)) {
                $length /= 1024 * 1024;
                return sprintf "%.1f%s", $length, "M";
        # K
        } elsif ($length > 1024) {
                $length /= 1024;
                return sprintf "%.1f%s", $length, "K";
        # B
        } else {
                return sprintf "%.1f%s", $length, "B";
        }
}

1;
